home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok11 / r.o.m. / m2sources / main.mod < prev    next >
Text File  |  1993-11-04  |  13KB  |  386 lines
  1. MODULE Main;
  2. (*Created:   3.3.88
  3.   Changed:   8.8.88 by
  4.              Stefan Salewski
  5.              Stolper Weg 3
  6.              2160 Stade   West-Germany
  7.              Tel: 04141/61130
  8.   Note: compiled with AMIGA Modula-2 System by AMSoft, Version from 5.5.88
  9.    
  10. *)
  11.  
  12. FROM Calcu IMPORT Tas;
  13. FROM Graph IMPORT Graf;
  14. FROM VarIO IMPORT VarInOut;
  15. FROM MyInfo IMPORT ShowInfo;
  16. FROM SYSTEM IMPORT ADR,ADDRESS,LONGSET,INLINE;
  17. FROM Arts IMPORT TermProcedure,Assert,Error;
  18. FROM Intuition IMPORT WindowPtr,ItemAddress,Gadget,IDCMPFlags,IDCMPFlagSet,
  19.   Image,GadgetFlags,GadgetFlagSet,ActivationFlags,ActivationFlagSet,
  20.   boolGadget,NewWindow,OpenWindow,CloseWindow,GadgetPtr,IntuiMessagePtr,
  21.   WindowFlags,WindowFlagSet,ScreenFlags,ScreenFlagSet;
  22. FROM Exec IMPORT WaitPort,GetMsg,ReplyMsg,CopyMem,MemReqs,MemReqSet,
  23.                  AllocMem,FreeMem,AvailMem;
  24.  
  25.     CONST
  26.     MinChip=50*1024; (* zum startem des Programmes benoetigter Speicher *)
  27.     MinRam=60*1024;
  28.     Height=32;
  29.     Width=84;
  30.     TopEdge=0;
  31.     LeftEdge=0;
  32.     BTop=12;
  33.     BLeft=15;
  34.     WindowWidth=3*BLeft+2*Width;
  35.     WindowHeight=BTop+3*(BTop DIV 2)+3*Height;
  36.     ImSize=400;
  37.   VAR
  38.     gadgets:ARRAY[0..4] OF Gadget;
  39.     images:ARRAY[0..4] OF Image;
  40.     newImAdr:ARRAY[0..4] OF ADDRESS;
  41.     newWindow:NewWindow;
  42.     windowPtr:WindowPtr;
  43.     msgPtr:IntuiMessagePtr;
  44.     msgadr:GadgetPtr;
  45.     ende:BOOLEAN;
  46.     n:INTEGER;
  47.     code:CARDINAL;
  48.     
  49. PROCEDURE GrafI; (*$E- Bild fuer GrafikGadget *)
  50. BEGIN
  51. INLINE(
  52. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H,
  53. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  54. 07000H,00000H,00000H,00000H,00000H,0E000H,
  55. 0E000H,00000H,00000H,08000H,00000H,07000H,
  56. 0E000H,00000H,00000H,08000H,00070H,07000H,
  57. 0E000H,00000H,00000H,08000H,00180H,07000H,
  58. 0E000H,00000H,00000H,08000H,00200H,07000H,
  59. 0E000H,003FFH,00000H,08000H,00400H,07000H,
  60. 0E000H,01C00H,0C000H,08000H,00800H,07000H,
  61. 0E000H,02000H,03000H,08000H,01000H,07000H,
  62. 0E000H,0C000H,00C00H,08000H,02000H,07000H,
  63. 0E001H,00000H,00200H,08000H,04000H,07000H,
  64. 0E002H,00000H,00100H,08000H,08000H,07000H,
  65. 0E004H,00000H,00080H,08000H,08000H,07000H,
  66. 0E008H,00000H,00040H,08001H,00000H,07000H,
  67. 0EFFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,07000H,
  68. 0E020H,00000H,00010H,08002H,00000H,07000H,
  69. 0E040H,00000H,00008H,08004H,00000H,07000H,
  70. 0E040H,00000H,00004H,08008H,00000H,07000H,
  71. 0E080H,00000H,00002H,08008H,00000H,07000H,
  72. 0E080H,00000H,00001H,08010H,00000H,07000H,
  73. 0E100H,00000H,00000H,08010H,00000H,07000H,
  74. 0E100H,00000H,00000H,0C020H,00000H,07000H,
  75. 0E000H,00000H,00000H,0E040H,00000H,07000H,
  76. 0E000H,00000H,00000H,0B180H,00000H,07000H,
  77. 0E000H,00000H,00000H,08E00H,00000H,07000H,
  78. 0E000H,00000H,00000H,08000H,00000H,07000H,
  79. 0E000H,00000H,00000H,08000H,00000H,07000H,
  80. 0E000H,00000H,00000H,08000H,00000H,07000H,
  81. 07000H,00000H,00000H,00000H,00000H,0E000H,
  82. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  83. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H
  84. )
  85. END GrafI;
  86. PROCEDURE TasI; (*$E- Bild fuer CalculatorGadget *)
  87. BEGIN
  88. INLINE(
  89. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H,
  90. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  91. 07000H,00000H,00000H,00000H,00000H,0E000H,
  92. 0E000H,00000H,00000H,00000H,00000H,07000H,
  93. 0E000H,00000H,00000H,00000H,00000H,07000H,
  94. 0E000H,00000H,00000H,00000H,00000H,07000H,
  95. 0E000H,00000H,00000H,00000H,00000H,07000H,
  96. 0E000H,00000H,00000H,00000H,00000H,07000H,
  97. 0E000H,00000H,00000H,00000H,00000H,07000H,
  98. 0E000H,00000H,00000H,00000H,00000H,07000H,
  99. 0E000H,00000H,00000H,00000H,00000H,07000H,
  100. 0E03FH,0000FH,08000H,00E00H,01F00H,07000H,
  101. 0E041H,08010H,0C000H,01E00H,03180H,07000H,
  102. 0E001H,08600H,06230H,03600H,00180H,07000H,
  103. 0E001H,08600H,0C160H,0667FH,00300H,07000H,
  104. 0E007H,03FC1H,08FFCH,0C600H,00600H,07000H,
  105. 0E001H,08603H,001A1H,08600H,00600H,07000H,
  106. 0E001H,08606H,02311H,0FF7FH,00000H,07000H,
  107. 0E041H,0800CH,06000H,00600H,00600H,07000H,
  108. 0E03EH,0001FH,0E000H,00F00H,00600H,07000H,
  109. 0E000H,00000H,00000H,00000H,00000H,07000H,
  110. 0E000H,00000H,00000H,00000H,00000H,07000H,
  111. 0E000H,00000H,00000H,00000H,00000H,07000H,
  112. 0E000H,00000H,00000H,00000H,00000H,07000H,
  113. 0E000H,00000H,00000H,00000H,00000H,07000H,
  114. 0E000H,00000H,00000H,00000H,00000H,07000H,
  115. 0E000H,00000H,00000H,00000H,00000H,07000H,
  116. 0E000H,00000H,00000H,00000H,00000H,07000H,
  117. 0E000H,00000H,00000H,00000H,00000H,07000H,
  118. 07000H,00000H,00000H,00000H,00000H,0E000H,
  119. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  120. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H
  121. )
  122. END TasI;
  123. PROCEDURE VarInOutI; (*$E- Bild fuer VarInOutGadget *)
  124. BEGIN
  125. INLINE(
  126. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H,
  127. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  128. 07000H,00000H,00000H,00000H,00000H,0E000H,
  129. 0E000H,00000H,00000H,00000H,00000H,07000H,
  130. 0E000H,00000H,00000H,00000H,00000H,07000H,
  131. 0E1FFH,00000H,0F807H,0FE7FH,01F80H,07000H,
  132. 0E0C1H,00001H,00C06H,00CC1H,0A0C0H,07000H,
  133. 0E0C0H,00000H,00604H,01841H,000C0H,07000H,
  134. 0E0C4H,031FCH,00C00H,0303EH,000C0H,07000H,
  135. 0E0FCH,03000H,01800H,06041H,00380H,07000H,
  136. 0E0C4H,00000H,03000H,060C1H,080C0H,07000H,
  137. 0E0C0H,001FCH,06200H,060C1H,080C0H,07000H,
  138. 0E0C1H,03000H,0C660H,06041H,020C0H,07000H,
  139. 0E1FFH,03001H,0FE60H,0603EH,01F00H,07000H,
  140. 0E000H,00000H,00000H,00000H,00000H,07000H,
  141. 0E000H,00000H,00000H,00000H,00000H,07000H,
  142. 0E000H,00003H,0F003H,000E0H,0C1E0H,07000H,
  143. 0E000H,00004H,01807H,001E1H,0C200H,07000H,
  144. 0E000H,00000H,0180FH,00363H,0C600H,07000H,
  145. 0E778H,0C7F0H,01803H,00660H,0C600H,07000H,
  146. 0E38CH,0C000H,07003H,00C60H,0C6F8H,07000H,
  147. 0E30CH,00000H,01803H,01860H,0C70CH,07000H,
  148. 0E30CH,007F0H,01803H,01FF0H,0C60CH,07000H,
  149. 0E30CH,0C004H,01983H,00060H,0C318H,07000H,
  150. 0E3F8H,0C003H,0E18FH,0C0F3H,0F1F0H,07000H,
  151. 0E300H,00000H,00000H,00000H,00000H,07000H,
  152. 0E300H,00000H,00000H,00000H,00000H,07000H,
  153. 0E780H,00000H,00000H,00000H,00000H,07000H,
  154. 0E000H,00000H,00000H,00000H,00000H,07000H,
  155. 07000H,00000H,00000H,00000H,00000H,0E000H,
  156. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  157. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H
  158. )
  159. END VarInOutI;
  160. PROCEDURE EndeI; (*$E- Bild fuer EndeGadget *)
  161. BEGIN
  162. INLINE(
  163. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H,
  164. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  165. 07000H,00000H,00000H,00000H,00000H,0E000H,
  166. 0E000H,00000H,00000H,00000H,00000H,07000H,
  167. 0E000H,00000H,00000H,00000H,00000H,07000H,
  168. 0E000H,00000H,00000H,00000H,00000H,07000H,
  169. 0E000H,00000H,00000H,00000H,00000H,07000H,
  170. 0E000H,00000H,00000H,00000H,00000H,07000H,
  171. 0E000H,00000H,00000H,00000H,00000H,07000H,
  172. 0E000H,00000H,00000H,00000H,00000H,07000H,
  173. 0E000H,00000H,00000H,00000H,00000H,07000H,
  174. 0E000H,00FF8H,00003H,08000H,00000H,07000H,
  175. 0E000H,00608H,00001H,08000H,00000H,07000H,
  176. 0E000H,00600H,00001H,08000H,00000H,07000H,
  177. 0E000H,00623H,07C3DH,087E0H,00000H,07000H,
  178. 0E000H,007E1H,08663H,08C30H,00000H,07000H,
  179. 0E000H,00621H,08661H,08FF0H,00000H,07000H,
  180. 0E000H,00601H,08661H,08C00H,00000H,07000H,
  181. 0E000H,00609H,08661H,08C10H,00000H,07000H,
  182. 0E000H,00FFBH,0CF3EH,0C7E0H,00000H,07000H,
  183. 0E000H,00000H,00000H,00000H,00000H,07000H,
  184. 0E000H,00000H,00000H,00000H,00000H,07000H,
  185. 0E000H,00000H,00000H,00000H,00000H,07000H,
  186. 0E000H,00000H,00000H,00000H,00000H,07000H,
  187. 0E000H,00000H,00000H,00000H,00000H,07000H,
  188. 0E000H,00000H,00000H,00000H,00000H,07000H,
  189. 0E000H,00000H,00000H,00000H,00000H,07000H,
  190. 0E000H,00000H,00000H,00000H,00000H,07000H,
  191. 0E000H,00000H,00000H,00000H,00000H,07000H,
  192. 07000H,00000H,00000H,00000H,00000H,0E000H,
  193. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  194. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H
  195. )
  196. END EndeI;
  197. PROCEDURE InfoI; (*$E- Bild fuer InfoGadget *)
  198. BEGIN
  199. INLINE(
  200. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H,
  201. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  202. 07000H,00000H,07F00H,00000H,00000H,0E000H,
  203. 0E000H,00001H,088C0H,07800H,00000H,07000H,
  204. 0E000H,00002H,02020H,0CC00H,00000H,07000H,
  205. 0E000H,00002H,08120H,00C3FH,08000H,07000H,
  206. 0E000H,00002H,02020H,01810H,07F00H,07000H,
  207. 0E000H,04001H,080F0H,03010H,00100H,07000H,
  208. 0E000H,04002H,07F00H,00010H,00100H,07000H,
  209. 0E000H,06002H,00800H,03010H,00100H,07000H,
  210. 0E000H,06018H,03000H,00010H,00100H,07000H,
  211. 0E000H,02020H,02000H,0003FH,0FF00H,07000H,
  212. 0E000H,03070H,02000H,00000H,00000H,07000H,
  213. 0E000H,0304CH,0100FH,081FFH,0FF00H,07000H,
  214. 0E000H,01042H,00874H,00100H,00100H,07000H,
  215. 0E000H,01841H,087C2H,0A900H,00100H,07000H,
  216. 0E000H,01840H,06D0FH,0FFFFH,0FFF0H,07000H,
  217. 0E000H,01840H,03000H,04000H,00200H,07000H,
  218. 0E000H,00C40H,03FFCH,04000H,00200H,07000H,
  219. 0E000H,00C40H,00004H,04000H,00200H,07000H,
  220. 0E000H,00C7FH,0FFE4H,04000H,00200H,07000H,
  221. 0E000H,00600H,00024H,04000H,00200H,07000H,
  222. 0E000H,007FFH,0FC24H,04000H,00200H,07000H,
  223. 0E000H,00100H,01024H,04000H,00200H,07000H,
  224. 0E000H,00100H,01024H,04000H,00200H,07000H,
  225. 0E000H,00100H,01024H,04000H,00200H,07000H,
  226. 0E000H,00100H,01024H,04000H,00200H,07000H,
  227. 0E000H,00100H,01027H,0C000H,00200H,07000H,
  228. 0E000H,00100H,0103FH,0FC00H,00200H,07000H,
  229. 07000H,00100H,01000H,04000H,00200H,0E000H,
  230. 03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,0C000H,
  231. 00FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,00000H
  232. )
  233. END InfoI;
  234.   PROCEDURE Cleanup;
  235.   VAR i:CARDINAL;
  236.   BEGIN
  237.     IF windowPtr#NIL THEN
  238.       CloseWindow(windowPtr);
  239.       windowPtr:=NIL
  240.     END;
  241.     FOR i:=0 TO 4 DO
  242.       IF newImAdr[i]#NIL THEN
  243.         FreeMem(newImAdr[i],ImSize)
  244.       END
  245.     END
  246.   END Cleanup;
  247.   
  248.   PROCEDURE InitImage(VAR im:Image;VAR newImAdr:ADDRESS;dates:ADDRESS);
  249.   BEGIN
  250.     WITH im DO
  251.       leftEdge:=0;
  252.       topEdge:=0;
  253.       width:=Width;
  254.       height:=Height;
  255.       depth:=1;
  256.       IF (dates+ImSize) >= 080000H THEN
  257.         newImAdr:=AllocMem(ImSize,MemReqSet{chip});
  258.         CopyMem(dates,newImAdr,ImSize);
  259.         imageData:=newImAdr
  260.       ELSE
  261.         newImAdr:=NIL;
  262.         imageData:=dates
  263.       END;
  264.       planePick:=1;
  265.       planeOnOff:=2;
  266.       nextImage:=NIL;
  267.     END;
  268.   END InitImage;
  269.   PROCEDURE InitGadget(VAR gadg:Gadget;id,leftE,topE:INTEGER;imAdr,
  270.                        next:ADDRESS);
  271.   BEGIN
  272.     WITH gadg DO
  273.       nextGadget:=GadgetPtr(next);
  274.       leftEdge:=leftE;
  275.       topEdge:=topE;
  276.       width:=Width;
  277.       height:=Height;
  278.       flags:=GadgetFlagSet{gadgImage};
  279.       activation:=ActivationFlagSet{gadgImmediate};
  280.       gadgetType:=boolGadget;
  281.       gadgetRender:=imAdr;
  282.       selectRender:=NIL;
  283.       gadgetText:=NIL;
  284.       mutualExclude:=LONGSET{};
  285.       specialInfo:=NIL;
  286.       gadgetID:=id;
  287.       userData:=NIL;
  288.     END;
  289.   END InitGadget;
  290.   
  291.   PROCEDURE Ende;
  292.   BEGIN
  293.     ende:=TRUE;
  294.   END Ende;
  295.   
  296. BEGIN
  297.   TermProcedure(Cleanup);
  298.   IF (AvailMem(MemReqSet{chip})<MinChip) OR (AvailMem(MemReqSet{})<MinRam)
  299.     THEN Error(ADR("Sorry. There isn't enough Memory"),
  300.                ADR('free for starting R.o.M.'))
  301.   END;
  302.   WITH newWindow DO
  303.     leftEdge:=LeftEdge;
  304.     topEdge:=TopEdge;
  305.     width:=WindowWidth;
  306.     height:=WindowHeight;
  307.     detailPen:=0;
  308.     blockPen:=1;
  309.     idcmpFlags:=IDCMPFlagSet{vanillaKey,gadgetDown,reqClear};
  310.     flags:=WindowFlagSet{activate,windowDrag,windowDepth,
  311.                          noCareRefresh,simpleRefresh};
  312.     type:=ScreenFlagSet{wbenchScreen};
  313.     firstGadget:=ADR(gadgets[0]);
  314.     checkMark:=NIL;
  315.     title:=ADR("R.o.M. V1.0");
  316.     screen:=NIL;
  317.     bitMap:=NIL;
  318.     minWidth:=WindowWidth;
  319.     minHeight:=WindowHeight;
  320.     maxWidth:=WindowWidth;
  321.     maxHeight:=WindowHeight;
  322.   END;
  323.   InitImage(images[0],newImAdr[0],ADR(GrafI));
  324.   InitImage(images[1],newImAdr[1],ADR(TasI));
  325.   InitImage(images[2],newImAdr[2],ADR(VarInOutI));
  326.   InitImage(images[3],newImAdr[3],ADR(EndeI));
  327.   InitImage(images[4],newImAdr[4],ADR(InfoI));
  328.   
  329.   InitGadget(gadgets[0],0,BLeft,BTop,ADR(images[0]),ADR(gadgets[1]));
  330.   InitGadget(gadgets[1],1,2*BLeft+Width,BTop,ADR(images[1]),ADR(gadgets[2]));
  331.   InitGadget(gadgets[2],2,3*(BLeft DIV 2)+Width DIV 2,3*(BTop DIV 2)+Height,
  332.              ADR(images[2]),ADR(gadgets[3]));
  333.   InitGadget(gadgets[3],3,BLeft,2*BTop+2*Height,ADR(images[3]),ADR(gadgets[4]));
  334.   InitGadget(gadgets[4],4,2*BLeft+Width,2*BTop+2*Height,ADR(images[4]),NIL);
  335.   ende:=FALSE;
  336.   windowPtr:=NIL;
  337.   REPEAT
  338.     IF windowPtr=NIL THEN
  339.       windowPtr:=OpenWindow(newWindow)
  340.     END;
  341.     Assert(windowPtr#NIL,ADR('Cannot Open Window'));
  342.     WaitPort(windowPtr^.userPort);
  343.     msgPtr:=GetMsg(windowPtr^.userPort);
  344.     IF msgPtr#NIL THEN
  345.       IF msgPtr^.class=IDCMPFlagSet{vanillaKey} THEN
  346.         code:=msgPtr^.code;
  347.       ELSE
  348.         code:=0;
  349.         msgadr:=msgPtr^.iAddress;
  350.         n:=msgadr^.gadgetID;
  351.       END;
  352.       ReplyMsg(msgPtr);
  353.       IF code#0 THEN
  354.         CASE CAP(CHAR(code)) OF
  355.           'C','T','R':n:=1|
  356.           'G','F':n:=0|
  357.           'E','Q','X':n:=3|
  358.           'V':n:=2|
  359.         ELSE
  360.           n:=5
  361.         END;
  362.       END;
  363.       IF n<4 THEN
  364.         CloseWindow(windowPtr);
  365.         windowPtr:=NIL
  366.       END;
  367.       CASE n OF
  368.         0:Graf|
  369.         1:Tas|
  370.         2:VarInOut|
  371.         3:Ende|
  372.         4:(*windowPtr:=OpenWindow(newWindow);*)
  373.           ShowInfo(windowPtr);
  374.           WaitPort(windowPtr^.userPort);
  375.           msgPtr:=GetMsg(windowPtr^.userPort);
  376.           IF msgPtr#NIL THEN
  377.             ReplyMsg(msgPtr)
  378.           END|
  379.         5:(* Do Nothing *)
  380.       ELSE
  381.         Error(ADR('Main'),ADR('UnknownMessage'))
  382.       END
  383.     END;
  384.   UNTIL ende;
  385. END Main.
  386.